home *** CD-ROM | disk | FTP | other *** search
/ Aminet 35 / Aminet 35 (2000)(Schatztruhe)[!][Feb 2000].iso / Aminet / dev / gui / gui4cli.lha / Gui4Cli / Tools / Palette.gc < prev    next >
Encoding:
Gui4CLI script  |  1999-11-26  |  6.7 KB  |  254 lines

  1. G4C
  2.  
  3. ; Palette.gc by D.Keletsekis & J.Collett
  4. ; ---------------------------------------------------------------
  5. ; A full palette gui with many capabilities
  6. ; Press CONTROL-J to make it jump screens
  7. ; ---------------------------------------------------------------
  8.  
  9. WINBIG 211 65 233 105 'Palette'
  10. wintype 11110001
  11. resinfo 8 640 256  ; info for auto-resize
  12.  
  13. BOX 0 0 233 105 out button
  14.  
  15. ; ---------------------------------------------------------------
  16. ;    system events
  17. ; ---------------------------------------------------------------
  18.  
  19. xonload
  20.     guiopen palette.gc
  21.  
  22. xonopen
  23.     info palette palette.gc/5    ; get info on *our* platte
  24.     type = 'update'            ; set the subroutine type
  25.     gosub palette.gc update        ; Subroutine
  26.  
  27. xonRMB        
  28.     ; on rmb we update to the color under mouse position
  29.     update palette.gc 5 $$mouse.color
  30.     ; and update since we did not click on the palette
  31.     gosub palette.gc update
  32.  
  33. xonclose
  34.     guiquit palette.gc
  35.  
  36. ; ---------------------------------------------------------------
  37. ;    palette & sliders
  38. ; ---------------------------------------------------------------
  39.  
  40. XPALETTE 8 4 217 28 
  41.     gadid 5
  42.     attr resize 0022
  43.     gadhelp 'Click on a color, (or click RMB anywhere else)'
  44.     gosub palette.gc $type
  45.  
  46. XHSLIDER 27 33 167 12 R red 0 15 0 %2ld
  47.     attr resize 0220
  48.     gadhelp "Adjust RED intensity"
  49.     setcolor palette.gc $$color.num $red $green $blue
  50.     gadid 1
  51.  
  52. XHSLIDER 27 45 167 12 G green 0 15 0 %2ld
  53.     attr resize 0220
  54.     gadhelp "Adjust GREEN intensity"
  55.     setcolor palette.gc $$color.num $red $green $blue
  56.     gadid 2
  57.  
  58. XHSLIDER 27 57 167 12 B blue 0 15 0 %2ld
  59.     attr resize 0220
  60.     gadhelp "Adjust BLUE intensity"
  61.     setcolor palette.gc $$color.num $red $green $blue
  62.     gadid 3
  63.  
  64.  
  65. ; ---------------------------------------------------------------
  66. ;    routine to update sliders & get variables
  67. ; ---------------------------------------------------------------
  68.  
  69. xRoutine update
  70.     ; get the current values from internal variables
  71.     red   = $$color.r
  72.     green = $$color.g
  73.     blue  = $$color.b
  74.     num   = $$color.num
  75.     total = $$color.total
  76.  
  77.     oldred   = $red        ; store old values for undo
  78.     oldgreen = $green
  79.     oldblue  = $blue
  80.  
  81.     update palette.gc 1 $red    ; Update sliders
  82.     update palette.gc 2 $green
  83.     update palette.gc 3 $blue
  84.  
  85.     setwintitle palette.gc 'Color $num of $total'
  86.  
  87.  
  88. ; ---------------------------------------------------------------
  89. ;    Undo button
  90. ; ---------------------------------------------------------------
  91.  
  92. XBUTTON 9 72 72 14 Undo     ; undo last changes
  93.     attr resize 1210
  94.     setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  95.     gosub palette.gc update
  96.  
  97.  
  98. ; ---------------------------------------------------------------
  99. ;    Load a previously saved palette 
  100. ;    (new IFF or old gui type palettes..)
  101. ; ---------------------------------------------------------------
  102.  
  103. XBUTTON 81 72 72 14 Load..
  104.     attr resize 1210
  105.     gadhelp "Load an IFF or an old GUI type palette"
  106.     filename = ''
  107.     ReqFile -1 -1 300 -40 'Load Palette gui:' LOAD filename 'GUIs:tools/palette'
  108.     if $filename > ' '
  109.  
  110.        if $filename H= "G4C"                ; old type palettes..
  111.           guiload $filename palette.gc    ; pass our gui name as argument
  112.           update palette.gc 5 1            ; go back to color No 1
  113.           info palette palette.gc/5        ; get info on palette
  114.           gosub palette.gc update            ; redraw the sliders etc
  115.  
  116.         elseif $filename H= "FORM????ILBM"
  117.             palette load $filename tempimage
  118.             palette set tempimage '*'
  119.             freeimage tempimage
  120.           gosub palette.gc update            ; redraw the sliders etc
  121.  
  122.        else
  123.           ezreq 'Please choose a Gui4Cli script pallete' OK ''
  124.        endif
  125.  
  126.     endif
  127.  
  128.  
  129. ; ---------------------------------------------------------------
  130. ;    Save a palette as normal iff
  131. ; ---------------------------------------------------------------
  132.  
  133. XBUTTON 153 72 72 14 Save..
  134.     attr resize 1210
  135.     gadhelp "Save palette as normal IFF palette"
  136.     filename = ''
  137.     ReqFile -1 -1 300 -40 'Save Palette as:' SAVE filename 'Guis:tools/palette'
  138.     if $filename = ''
  139.        stop
  140.     endif
  141.  
  142.     setwintitle palette.gc 'Saving Palette...'
  143.     palette get '*' tempimage
  144.     palette save tempimage $filename
  145.     freeimage tempimage
  146.     gosub palette.gc update
  147.  
  148.  
  149. ; ---------------------------------------------------------------
  150. ;     Copy, Exchange, Spread buttons
  151. ; ---------------------------------------------------------------
  152.  
  153. XBUTTON 9 87 72 14 Copy
  154.     attr resize 1210
  155.     gosub palette.gc fixvalues
  156.     type = 'copy'
  157.  
  158. XBUTTON 81 87 72 14 Exchange
  159.     attr resize 1210
  160.     gosub palette.gc fixvalues
  161.     type = 'exchange'
  162.  
  163. XBUTTON 153 87 72 14 Spread
  164.     attr resize 1210
  165.     gosub palette.gc fixvalues
  166.     type = 'spread'
  167.  
  168. ; store the current values in undo since we'll need them
  169. xRoutine fixvalues
  170.     oldred   = $red
  171.     oldgreen = $green
  172.     oldblue  = $blue
  173.  
  174. ; ---------------------------------------------------------------
  175. ;    routine to copy values
  176. ; ---------------------------------------------------------------
  177.  
  178. xRoutine copy
  179.     ;Set new colour to old values
  180.     setcolor palette.gc $$color.num $oldred $oldgreen $oldblue
  181.     type = 'update'        ; Reset routine flag
  182.     setwintitle palette.gc 'Copied color $num to $$color.num'
  183.     num = $$color.num
  184.     update palette.gc 5 $num
  185.     gosub palette.gc update
  186.  
  187.  
  188. ; ---------------------------------------------------------------
  189. ;    routine to exchange values
  190. ; ---------------------------------------------------------------
  191.  
  192. xRoutine exchange
  193.     pal.on = $num       ; Store existing colour number
  194.     red = $$color.r     ; get new values  
  195.     green = $$color.g
  196.     blue = $$color.b
  197.     num = $$color.num
  198.     ;Set each colour to other values
  199.     setcolor palette.gc $num  $oldred $oldgreen $oldblue
  200.     setcolor palette.gc $pal.on  $red $green $blue
  201.     type = 'update'             ; Reset routine flag
  202.     ; Update window title
  203.     setwintitle palette.gc 'Exchanged colors $pal.on and $num'
  204.     update palette.gc 5 $num
  205.     gosub palette.gc update
  206.  
  207.  
  208. ; ---------------------------------------------------------------
  209. ;    Routine to do the spreading.
  210. ; ---------------------------------------------------------------
  211.  
  212. xROUTINE spread 
  213.     ; use local variables..
  214.     local col2/r2/g2/b2/rstep/gstep/bstep/sign/colnum/r/g/b
  215.     ; get the 2nd color values
  216.     col2 = $$color.num
  217.     r2   = $$color.r 
  218.     g2   = $$color.g
  219.     b2   = $$color.b
  220.  
  221.     ; if there is no spread, return
  222.     if $(abs($num - $col2)) <= 1
  223.        return
  224.     endif
  225.  
  226.     ; which direction are we going
  227.     sign = 1
  228.     if $num > $col2
  229.        sign = -1
  230.     endif
  231.  
  232.     ; how many colors are we spreading ?
  233.     colnum = $(abs($col2 - $num) - 1)
  234.  
  235.     ; work out the change step for each color
  236.     rstep  = $(($r2 - $oldred)   / $colnum) 
  237.     gstep  = $(($g2 - $oldgreen) / $colnum) 
  238.     bstep  = $(($b2 - $oldblue)  / $colnum) 
  239.  
  240.     ; set all colors
  241.     count = 0
  242.     while $count < $colnum
  243.        ++count
  244.        ; use == so we get integers (should add trunc(x) function)
  245.        r == $($oldred   + ($count * $rstep)) * 1
  246.        g == $($oldgreen + ($count * $gstep)) * 1
  247.        b == $($oldblue  + ($count * $bstep)) * 1
  248.        setcolor palette.gc $($num + ($count * $sign)) $r $g $b
  249.     endwhile
  250.  
  251.     type = 'update'             ; Reset routine flag
  252.     gosub palette.gc update
  253.  
  254.